COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	∂28-Jan-86  1003	JJW  	Here's some code   
C00011 ENDMK
C⊗;
∂28-Jan-86  1003	JJW  	Here's some code   
This is from the DVIdover program, which converts DVI files to Press files

comment inTFM;

procedure inTFM(string name; integer atsize,checksum);
	comment Read the width information for font number nf (internal),
	with magnification atsize/1000 times the font design size.
	Dimensions are stored as quantities in the internal unit system
	of the DVI file;
begin "inTFM"
integer i,j,temp,lh,fbt;
integer bc, ec, RSUsize;
integer tfmchan;
string s;

integer strptr;
integer hash;

integer nw # number of words in the width table;
integer wp # new value of widthptr after successful input;
integer array inwidth[0:255] # TFM width data in DVI units;
integer alpha,beta # quantities used in the scaling computation;
integer byte0, byte1, byte2, byte3 # bytes of a word;

comment Open the TFM file;
scanfilename(name) # put components in fname;
if fname[2]=0 then
    begin
WAITS!
	fname[2]←"[TEX,SYS]";
	name←fname[0]&fname[1]&fname[2] # let's play it safe;
!WAITS
TOPS20!
	fname[2]←"TeXFonts:";
	name←fname[2]&fname[0]&fname[1] # let's play it safe;
!TOPS20
    end;

hash←0;
strptr ← memory[location(name) land '777777];
for i thru length(name) do hash ← hash + ildb(strptr);
hash ← (hash*7) mod maxPL;

RSUsize←((atsize*conv*1000)/(magnification*micasPerRSU))+0.5 # actual size of font in rsu's;

if fonts_preloaded then
begin
    i ← hash;
    loop
	begin
	i ← (i+1) mod maxPL;
	if PLstr[i,1] = 0 then done;
	if not equ(PLname[i], name) then continue;
	if not RSUsize = PLsize[i] then continue;
	if (PLchecksum[i] and checksum and PLchecksum[i]-checksum) then
	  warn("(Preloading) Font checksums do not agree DVI='"&cvos(checksum)&", "
	       &fontname[nf]&"='"&cvos(i));
	fontname[nf] ← PLname[i];
	widthbase[nf]←PLbase[i];
	fontbc[nf]←PLbc[i];
	fontec[nf]←PLec[i];
	fontspace[nf]←PLspace[i];
	fsize[nf]←PLsize[i];
	fpfb[nf]←PLpfb[i];
	for j thru 5 do fpfi[nf,j]←PLpfi[i,j];
	if PLconv ≠ pconv then
	    for i ← widthbase[nf]+fontbc[nf] upto widthbase[nf]+fontec[nf] do
		pixelwidth[i] ← pixelround(width[i]);
	return;
	end;
end;

WAITS!
s←fname[0]&".TFM"&fname[2] # name of auxiliary font information file;
open(tfmchan←getchan,"DSK",8,19,0,0,0,eof);
lookup(tfmchan,s,eof);
if eof then error("Lookup failed on file "&s);
!WAITS
TOPS20!
s←fname[2]&fname[0]&".TFM" # name of auxiliary font information file;
tfmchan←openfile(s,"ROE");
if tfmchan<0 then error("Unable to open file "&s);
!TOPS20

comment the .TFM file is available;
DEBUGONLY if (DEBUG land iooperations) then print(nextline,"Reading fontinfo[",s,"].");

comment Read past the header data;
temp←wordin(tfmchan); lh←rhalf(temp);
temp←wordin(tfmchan); bc←lhalf(temp); ec←rhalf(temp);
if ec<bc then bc←ec+1;
if widthptr+ec-bc+1>maxwidths then overflow(maxwidths);
wp←widthptr+ec-bc+1;
temp←wordin(tfmchan); nw←lhalf(temp);
if nw=0 or nw>256 then error("Too many widths in TFM file for font "&fontname[nf]);
wordin(tfmchan); wordin(tfmchan); wordin(tfmchan) # skip sizes of other subtables;
i←wordin(tfmchan) lsh -4;
if (i and checksum and i-checksum) then
  warn("Font checksums do not agree DVI='"&cvos(checksum)&", "
       &fontname[nf]&"='"&cvos(i));
checksum←i # TFM version of the checksum;
wordin(tfmchan) # skip design size of font;
for i←1 upto 10 do temp←wordin(tfmchan) # throw away character coding scheme;

if fonts_preloaded
then begin
    fontname[nf] ← name;
    fontbc[nf]←bc;
    fontec[nf]←ec;
    widthbase[nf]←widthptr-bc;
    for j←1 upto 5 do fpfi[nf,j]←wordin(tfmchan) # Parc Font Id;
    fpfb[nf]←(((fbt←wordin(tfmchan)) lsh -4) land '377) # Parc Face Byte;
    fsize[nf]←RSUsize;
    fontspace[nf]←atsize div 6;
end
else begin
    i ← (hash+1) mod maxPL;
    while PLstr[i,1] do i ← (i+1) mod maxPL;
    strptr ← memory[location(name) land '777777];
    PLstr[i,1] ← length(name);
    PLstr[i,2] ← poolptr;
    poolused ← poolused + length(name);
    if (poolused-1) DIV 5 > poolsize
    then overflow(poolsize);
    for j ← 1 upto length(name) do
	idpb(ildb(strptr), poolptr);
    PLbc[i]←bc;
    PLec[i]←ec;
    PLchecksum[i]←checksum;
    PLbase[i]←widthptr-bc;
    for j←1 upto 5 do PLpfi[i,j]←wordin(tfmchan);
    PLpfb[i]←(((fbt←wordin(tfmchan)) lsh -4) land '377);
    PLsize[i]←RSUsize;
    PLspace[i]←atsize div 6;
end;

for i←1 upto lh-18 do temp←wordin(tfmchan) # throw away rest of header;

comment Store character width indices at the end of the width table;
if wp>0 then arryin(tfmchan,width[widthptr],wp-widthptr);

comment Read and convert the width values, setting up the inwidth table;
alpha←16*atsize; beta←16;
while atsize≥'40000000 do
	begin
	atsize←atsize div 2;
	beta←beta div 2;
	end;
for i←0 upto nw-1 do
	begin
	temp←wordin(tfmchan);
	temp←temp rot 8;
	byte0←temp land '377;
	temp←temp rot 8;
	byte1←temp land '377;
	temp←temp rot 8;
	byte2←temp land '377;
	temp←temp rot 8;
	byte3←temp land '377;
	inwidth[i]←(((((byte3*atsize) div '400)+(byte2*atsize)) div '400)
		+(byte1*atsize)) div beta;
	if byte0>0 then
		if byte0<255 then error("Bad DVI file: bad width")
		else inwidth[i]←inwidth[i]-alpha;
	end;

comment Move the widths from inwidth to width;
if wp>0 then
	for i←widthptr upto wp-1 do
		begin
		byte0←(width[i] rot 8) land '377;
		width[i]←inwidth[byte0];
		pixelwidth[i]←pixelround(width[i]);
		end;

widthptr←wp;
release(tfmchan);
end "inTFM";